home *** CD-ROM | disk | FTP | other *** search
- /*
- * tclStruct package
- * Support 'C' structures in Tcl
- *
- * Written by Matthew Costello
- * (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
- *
- * See the file "license.terms" for information on usage and
- * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
- #include "stInternal.h"
- STRUCT_SCCSID("@(#)tclStruct:stDebug.c 1.1 95/09/08")
-
- #ifdef DEBUG
- /* When DEBUG is defined, enable the display of debugging messages.
- */
- int struct_debug = DEBUG;
- static struct {
- const char *name;
- int value;
- } debug_names[] = {
- { "refcount", DBG_REFCOUNT },
- { "newtype", DBG_NEWTYPE },
- { "parsetype", DBG_PARSETYPE },
- { "parseelement", DBG_PARSEELEMENT },
- { "lookup", DBG_LOOKUP },
- { "newobject", DBG_NEWOBJECT },
- { "getobject", DBG_GETOBJECT },
- { "float", DBG_FLOAT },
- { "int", DBG_INT },
- { "char", DBG_CHAR },
- { "array", DBG_ARRAY },
- { "unset", DBG_UNSET },
- { "command", DBG_COMMAND },
- { "varlen", DBG_VARLEN },
- { "io", DBG_IO },
- { "all", ~0 },
- { "none", 0 },
- { NULL, 0 }
- };
-
- void
- Struct_PrintCommand(argc,argv)
- int argc;
- char **argv;
- {
- int i;
- printf("COMMAND:");
- for ( i = 0; i < argc; i++ )
- printf(" %s", argv[i] );
- printf("\n");
- }
-
- /*ARGSUSED*/
- int
- Struct_DebugInfo(cdata,interp,argc,argv)
- ClientData cdata;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int i, l, n;
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " debug +/-debugFlagName\"", (char *) NULL);
- return TCL_ERROR;
- }
- for ( i = 2; i < argc; i++ ) {
- if (*argv[i] != '+' && *argv[i] != '-') {
- Tcl_AppendResult(interp,
- "debug flags must be preceeded by '+' or '-'", NULL );
- return TCL_ERROR;
- }
- l = strlen( argv[i]+1 );
- for ( n = 0; debug_names[n].name ; n++ ) {
- if (strncmp( debug_names[n].name, argv[i]+1, l ) == 0) {
- break;
- }
- }
- if (!debug_names[n].name) {
- Tcl_AppendResult(interp,
- "debug flag \"", argv[i]+1, "\" does not exist", NULL );
- return TCL_ERROR;
- } else if (*argv[i] == '-') {
- struct_debug &= ~debug_names[n].value;
- } else {
- struct_debug |= debug_names[n].value;
- }
- }
- Tcl_ResetResult(interp);
- sprintf(interp->result,"%u",struct_debug);
- return TCL_OK;
- }
- #endif
-